Collection of Tools & Utilities/Collection of Tools and Utilities.iso/ada/gnat1792.zip/gnat179b/t-adainc/i-c.adb

Text File | 1994-05-19 | 7KB | 246 lines

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                         I N T E R F A C E S . C                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.1 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
--                                                                          --
------------------------------------------------------------------------------

package body Interfaces.C is

   ------------
   -- To_Ada --
   ------------

   --  Convert Char_Array to String (function form)

   function To_Ada
     (Item     : in Char_Array;
      Trim_Nul : in Boolean := True)
      return     String
   is
      Result : String (1 .. Item'Length);

   begin
      for J in Item'range loop
         if Item (J) = Nul and then Trim_Nul then
            return Result (1 .. J - Item'First + Result'First - 1);
         else
            Result (J - Item'First + Result'First) := C_To_Ada (Item (J));
         end if;
      end loop;

      if Trim_Nul then
         raise Unterminated;
      end if;

      return Result;
   end To_Ada;

   --  Convert Char_Array to String (procedure form)

   procedure To_Ada
     (Item       : in  Char_Array;
      Target     : out String;
      Last       : out Natural;
      Trim_Nul   : in Boolean := True)
   is
   begin
      Last := 0;

      for J in Item'range loop
         if Item (J) = Nul and then Trim_Nul then
            return;
         end if;

         Last := Last + 1;
         Target (Last) := C_To_Ada (Item (J));
      end loop;

      if Trim_Nul then
         raise Unterminated;
      end if;
   end To_Ada;

   --  Convert WChar_T to Wide_Character

   function To_Ada (Item : in WChar_T) return Wide_Character is
   begin
      return Wide_Character (Item);
   end To_Ada;

   --  Convert Wide_Char_Array to Wide_String (function form)

   function To_Ada
     (Item        : in  Wide_Char_Array;
      Trim_Nul    : in  Boolean := True)
      return        Wide_String
   is
      Result : Wide_String (1 .. Item'Length);

   begin
      for J in Item'range loop
         if Item (J) = Wide_Nul and then Trim_Nul then
            return Result (1 .. J - Item'First + Result'First - 1);
         else
            Result (J - Item'First + Result'First) :=
              Wide_Character (Item (J));
         end if;
      end loop;

      if Trim_Nul then
         raise Unterminated;
      end if;

      return Result;
   end To_Ada;

   --  Convert Wide_Char_Array to Wide_String (procedure form)

   procedure To_Ada
     (Item       : in  Wide_Char_Array;
      Target     : out Wide_String;
      Last       : out Natural;
      Trim_Nul   : in  Boolean := True)
   is
   begin
      Last := 0;

      for J in Item'range loop
         if Item (J) = Wide_Nul and then Trim_Nul then
            return;
         end if;

         Last := Last + 1;
         Target (Last) := Wide_Character (Item (J));
      end loop;

      if Trim_Nul then
         raise Unterminated;
      end if;
   end To_Ada;

   ----------
   -- To_C --
   ----------

   --  Convert String to Char_Array (function form)

   function To_C
     (Item       : in String;
      Append_Nul : in Boolean := True)
      return       Char_Array
   is
      Result : Char_Array (0 .. Item'Length - Boolean'Pos (not Append_Nul));

   begin
      for J in Item'range loop
         Result (J - Item'First) := Ada_To_C (Item (J));
      end loop;

      if Append_Nul then
         Result (Item'Length) := Nul;
      end if;

      return Result;
   end To_C;

   --  Convert String to Char_Array (procedure form)

   --  Note: in the following procedure, we are relying on the built in
   --  constraint checking to propagate Constraint_Error when required,
   --  so checks must be on if this checking is required.

   procedure To_C
     (Item       : in  String;
      Target     : out Char_Array;
      Last       : out Integer;
      Append_Nul : in  Boolean := True)
   is
   begin
      Last := -1;

      for J in Item'range loop
         Last          := Last + 1;
         Target (Last) := Ada_To_C (Item (J));
      end loop;

      if Append_Nul then
         Last          := Last + 1;
         Target (Last) := Nul;
      end if;
   end To_C;

   --  Convert Wide_Character to Wchar_T

   function To_C (Item : in Wide_Character) return WChar_T is
   begin
      return WChar_T (Item);
   end To_C;

   --  Convert Wide_String to Wide_Char_Array (function form)

   function To_C
     (Item        : in  Wide_String;
      Append_Nul  : in  Boolean := True)
      return        Wide_Char_Array
   is
      Result :
        Wide_Char_Array (0 .. Item'Length - Boolean'Pos (not Append_Nul));

   begin
      for J in Item'range loop
         Result (J - Item'First) := WChar_T (Item (J));
      end loop;

      if Append_Nul then
         Result (Item'Length) := Wide_Nul;
      end if;

      return Result;
   end To_C;

   --  Convert Wide_String to Wide_Char_Array (procedure form)

   --  Note: in the following procedure, we are relying on the built in
   --  constraint checking to propagate Constraint_Error when required,
   --  so checks must be on if this checking is required.

   procedure To_C
     (Item       : in  Wide_String;
      Target     : out Wide_Char_Array;
      Last       : out Integer;
      Append_nul : in  Boolean := True)
   is
   begin
      Last := -1;

      for J in Item'range loop
         Last          := Last + 1;
         Target (Last) := WChar_T (Item (J));
      end loop;

      if Append_Nul then
         Last          := Last + 1;
         Target (Last) := Wide_Nul;
      end if;
   end To_C;

end Interfaces.C;